home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
HAMRADIO
/
WHATSON.ZIP
/
WHATSON.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-07-19
|
13KB
|
276 lines
10 KEY OFF:WIDTH "LPT1:",132:W$ = "WHATSON- HF propagation Prediction Program Version 1.91"
20 ON ERROR GOTO 600
30 DIM W$(500),A3(500),A4(500),L(1),T1(1),T3(1),T4(1),C0(1),T9(1),M(1),G6(1),G7(1),G8(1)
40 WIDTH 80:CLS:LOCATE 2,9:PRINT W$
50 BLANK$ = " ":FOR I = 1 TO 80:BLANK$ = BLANK$+" ":NEXT:LA$ = "LAT.":NA$ = " LON."
60 C1$ = CHR$(10)+CHR$(10)+CHR$(10):C2$ = CHR$(12)
70 D$ = "YyNnQq":X$ = "SsLl":Z$ = "PpSs":LA$ = "LAT.":NA$ = "LON.":P$ = "SHORT"
80 P1 = 3.14159266#
90 LOCATE 5,17:PRINT "BASED ON MINIMUF-3 PROGRAM DEVISED BY:"
100 LOCATE 7,18:PRINT "P.H LEVINE, R.B. ROSE J.N. MARTIN"
110 LOCATE 9,15:PRINT"MODIFIED BY G3CCZ,G4LH,G4GKO,4X4AS and G3ZCZ"
120 OPEN "G3ZCZ.DAT" FOR INPUT AS 1 ' GET STATION DATA
130 INPUT#1,G3ZCZ$,L5,W5:CLOSE#1
140 I% = 1:OPEN "WHATSON.DAT" FOR INPUT AS 1
150 GOSUB 700:GOSUB 2710:LOCATE 21,10:PRINT "PLEASE STANDBY WHILE PREFIX DATA ARE LOADED "
160 IF EOF(1) THEN 180
170 INPUT#1, W$(I%),A3(I%),A4(I%):I% = I%+1:GOTO 160
180 CLOSE#1:PX = I%-1
190 CR=0:GOSUB 410:LL$=Y$
200 IF M1 = 1 THEN 230 ELSE CLS
210 ' MAIN LOOP STARTS HERE
220 J9=P1/180: LN8=99:FOR CH9 = 1 TO PX: J9=P1/180: PX$ = W$(CH9):L6 = A3(CH9):W6 = A4(CH9):GOSUB 960 :NEXT CH9:GOTO 320
230 J9=P1/180:I = 1:CLS:LOCATE 1,32:PRINT "PREFIX MENU":PRINT:FOR C = 1 TO 4:PRINT " NBR PX";TAB(1+C*20);:NEXT: GOTO 250
240 FOR R = 4 TO 20:LOCATE R,1:PRINT BLANK$:NEXT
250 FOR C = 1 TO 4:FOR R = 4 TO 20:LOCATE R,(C-1)*20+1:PRINT I;:LOCATE R,(C-1)*20+6:PRINT "- ";W$(I):I = I+1:IF I>PX THEN I = 1
260 NEXT:NEXT
270 LOCATE 22,1:PRINT BLANK$:LOCATE 22,1:INPUT "Pick a number corresponding to a prefix (0 will give you further choices )";CH9:IF CH9 = 0 THEN 240
280 IF CH9 = 999 THEN GOSUB 490: GOTO 230
290 IF CH9<0 OR CH9>PX THEN 270
300 PX$ = W$(CH9):L6 = A3(CH9):W6 = A4(CH9) 'SET UP DESTINATION CO-ORDINATES
310 GOSUB 960
320 IF C2$= C1$ THEN 340
330 PRINT CHR$(12):IF P%=2 THEN LPRINT CHR$(12);CHR$(18)
340 PRINT:PRINT TAB(20)"DO YOU WANT ANOTHER QTH Y/N ?"
350 K$ = INKEY$:IF K$ = "" THEN 350
360 K = INSTR(D$,K$):IF K>0 THEN 380
370 BEEP:GOTO 350
380 IF K = 1 OR K = 2 THEN GOSUB 700: GOSUB 2710:GOTO 200
390 IF K = 3 OR K = 4 THEN 690
400 BEEP:GOTO 210
410 ' CALCULATE QRA SQUARE
420 IF CR = 0 THEN P = W5:R = L5 ELSE P = W6:R = L6
430 IF P>180 THEN P = P-360
440 P = (P+180)/20:R = (R+90)/10
450 Y = INT(P):X = INT(R):P = (P-Y)*10:R = (R-X)*10:C = INT(P):D = INT(R)
460 Y$ = CHR$(Y+65)+CHR$(X+65)+CHR$(C+48)+CHR$(D+48)
470 Y$ = Y$+CHR$(INT((P-C)*24)+65)+CHR$(INT((R-D)*24)+65)
480 Y$ = Y$:FOR K = 0 TO 5: Y(K) = ASC(MID$(Y$,K+1,1)):NEXT K:RETURN
490 ' SET UP G3ZCZ FOR YOUR STATION
500 CLS: LOCATE 2,9:PRINT W$:LOCATE 5,1: INPUT "What is your Call ";AA$
510 IF LEN(AA$) = 0 THEN 520 ELSE G3ZCZ$ = AA$
520 INPUT "What is your lattitude in degrees North ";J9: IF J9 = 0 THEN 530 ELSE L5 = J9
530 INPUT "What is your Longitude in degrees East ";J9: IF J9 = 0 THEN 540 ELSE W5 = J9
540 CLS:LOCATE 2,9: PRINT W$:LOCATE 8,1: PRINT "CALL SIGN ";TAB(30);G3ZCZ$:
550 LOCATE 10,1: PRINT "LATITUDE (Degrees North)";TAB(30);L5
560 LOCATE 12,1: PRINT "LONGITUDE (Degrees East)";TAB(30);W5
570 LOCATE 18,1: INPUT "Are the data correct (Y/N) ";AA$
580 IF LEFT$(AA$,1) = "Y" THEN 590 ELSE 500
590 OPEN "G3ZCZ.DAT" FOR OUTPUT AS 1: PRINT #1,G3ZCZ$;",";L5;",";W5: CLOSE #1: RETURN
600 ' ERROR TRAPPING ROUTINES
605 IF ERR = 62 AND ERL = 170 THEN RESUME 180
610 IF ERR <> 53 THEN 670
620 IF ERL =140 THEN BEEP:PRINT:PRINT "ERROR- WHATSON.DAT IS NOT ON LOGGED IN DRIVE":GOTO 690
630 BEEP:PRINT "ERROR- ":PRINT "G3ZCZ.DAT FILE Which holds your Geographical data IS NOT ON LOGGED IN DRIVE":PRINT:PRINT
640 INPUT " Do you want to create the file now ";AA$: IF LEN(AA$)=0 THEN 640
650 IF LEFT$(AA$,1) = "N" THEN 690 ELSE IF LEFT$(AA$,1) = "Y" THEN 660 ELSE 640
660 GOSUB 490:RESUME 140
670 IF ERR = 27 THEN PRINT "PRINTER OUT OF PAPER"
680 PRINT "ERROR ";ERR;" ON LINE ";ERL
690 END
700 CLS:LOCATE 2,10:PRINT "Are predictions for today (Y/N) "
710 K$ = INKEY$:IF K$ = "" THEN 710
720 K = INSTR(D$,K$): IF K = 1 OR K = 2 THEN 750
730 IF K = 3 OR K = 4 THEN 760
740 BEEP:GOTO 710
750 M0 = VAL(MID$(DATE$,1,2)):D0 = VAL(MID$(DATE$,4,2)): GOTO 800
760 LOCATE 4,10:INPUT "DAY";D0
770 IF D0<1 OR D0>31 THEN BEEP:GOTO 760
780 LOCATE 6,10:INPUT "MONTH(1...12) ";M0
790 IF M0<1 OR M0>12 THEN BEEP:GOTO 780
800 M0$=MID$("JanFebMarAprMayJunJulAugSepOctNovDec",(M0-1)*3+1,3)
810 LOCATE 8,10:INPUT "SUNSPOT NUMBER ";S0
820 IF ABS(W5-W6)<80 THEN K = 1: GOTO 870
830 LOCATE 10,20:PRINT"LONG OR SHORT PATH (L/S) ?"
840 K$ = INKEY$:IF K$ = "" THEN 840
850 K = INSTR(X$,K$):IF K>0 THEN 870
860 BEEP:GOTO 840
870 IF K = 1 OR K = 2 THEN P$ = "SHORT"
880 IF K = 3 OR K = 4 THEN P$ = "LONG"
890 LOCATE 12,10:PRINT"Output to printer (P) or Screen (S) ?"
900 K$ = INKEY$:IF K$ = "" THEN 900
910 K = INSTR(Z$,K$):IF K>0 THEN 930
920 BEEP:GOTO 900
930 IF K = 1 OR K = 2 THEN P% = 2:PL=55:C2$ = CHR$(12):GOTO 950
940 C2$ = C1$:PL=20
950 RETURN
960 IF P% = 2 THEN LPRINT CHR$(15);
970 W1 = -(W5-180*(1+SGN(W5-.001)))*J9
980 W2 = -(W6-180*(1+SGN(W6-.001)))*J9
990 L1 = L5*J9:L2 = L6*J9
1000 IF M1 = 1 THEN CLS:PRINT "G3ZCZ "+W$:PRINT " DAY:";D0;" MONTH:";M0;" SUN SPOT NUMBER:";S0
1010 IF M1 = 1 THEN IF P%=2 THEN LPRINT "G3ZCZ "+W$:LPRINT " DAY:";D0;" MONTH:";M0;" SUN SPOT NUMBER:";S0
1020 ' ROTATE LONGITUDE
1030 W3 = W2-W1+.001
1040 W3 = P1*(1-SGN(W3))+W3
1050 ' PATH LENGTH
1060 H1 = SIN(L1)*SIN(L2)+COS(L1)*COS(L2)*COS(W3)
1070 G1 = ATN (SQR(1 - H1*H1)/H1)+P1/2*(1-SGN(H1))
1080 IF P$ = "LONG" THEN G1 = P1+P1-G1
1090 IF M1= 2 THEN 1140
1100 N$ = "N":IF L5<0 THEN N$ = "S" ELSE IF L5 = 0 THEN N$ = " "
1110 IF W5 = 360 OR W5 = 0 THEN E$ = " " ELSE E$="E"
1120 PRINT:PRINT G3ZCZ$;" LOCAL QTH IS:";LA$;L5;N$;"/";NA$;W5;ES$;" = ";LL$:PRINT
1130 IF P%=2 THEN LPRINT:LPRINT G3ZCZ$;" LOCAL QTH IS:";LA$;L5;N$;"/";NA$;W5;ES$;" = ";LL$:LPRINT
1140 ' PATH LENGTH IN 4000 KM UNITS.
1150 H0 = INT(1.59*G1)+1
1160 ' BEARINGS.
1170 H9 = (SIN(L2)-H1*SIN(L1))/SIN(G1)/COS(L1)
1180 IF H9 < -.99999 THEN H9 = ATN(P1/2*(1-SGN(H9))):GOTO 1200
1190 H9 = ATN(SQR(1-H9*H9)/H9)+P1/2*(1-SGN(H9))
1200 H9 = H9*SGN(W3-P1)*SGN(P1-G1)
1210 H9 = H9+P1*(1-SGN(H9))
1220 BEARING=INT(H9/J9+.5):DISTANCE=INT(6356.775#*G1+.5)
1230 IF M1 = 1 THEN 1270
1240 LN8=LN8+1:IF LN8>PL THEN GOSUB 2630:LN8=1
1250 PRINT PX$;TAB(8);:IF P%=2 THEN LPRINT PX$;TAB(9);:LPRINT USING " ###";BEARING;:LPRINT USING " ##,### ";DISTANCE;
1260 GOTO 1330
1270 PRINT P$;" PATH TO ";PX$;", BEARING:";INT(H9/J9+.5);"deg. ";" DISTANCE:";INT(6356.775#*G1+.5);" KM ":PRINT
1280 IF P%=2 THEN LPRINT P$;" PATH TO ";PX$;", BEARING:";BEARING;"deg. ";" DISTANCE:";DISTANCE;" KM ":LPRINT
1290 PRINT "DATE & TIME OF PRINTOUT:";DATE$;"/";TIME$:PRINT
1300 IF P%=2 THEN LPRINT "DATE & TIME OF PRINTOUT:";DATE$;"/";TIME$:LPRINT
1310 PRINT TAB(3)"GMT" TAB(9)"HPF" TAB(16)"FOT" TAB(23)"LUF" TAB(41)"GMT" TAB(47)"HPF" TAB(54)"FOT" TAB(61)"LUF"
1320 IF P%=2 THEN LPRINT TAB(3)"GMT" TAB(9)"HPF" TAB(16)"FOT" TAB(23)"LUF" TAB(41)"GMT" TAB(47)"HPF" TAB(54)"FOT" TAB(61)"LUF"
1330 Y6 = ATN(1/TAN(G1/(H0+1))-.952/SIN(G1/(H0+1)))
1340 IF Y6<.314 THEN Y6 = .314
1350 Y6 = 1/SQR(1-.9650001*COS(Y6)^2)
1360 Y1 = .0172*(10+(M0-1)*30.4+D0)
1370 Y2 = .409*COS(Y1)
1380 Y1 = .13*SIN(Y1)+.156*SIN(Y1+Y1)
1390 ' DIRECTION COSINE.
1400 H9 = (SIN(L1)-COS(G1)*SIN(L2))/SIN(G1)/COS(L2)
1410 ' "M" FACTOR.
1420 M9 = SIN(2.5*G1/H0)
1430 M9 = 1+2.5*M9*SQR(M9)
1440 K1 = 1-.5/H0
1450 FOR N = 0 TO 1
1460 ' CONTROL POINT
1470 L9 = COS(G1*K1)*SIN(L2)+SIN(G1*K1)*COS(L2)*H9
1480 L0 = P1/2-(ATN(SQR(1-L9*L9)/L9)+P1/2*(1-SGN(L9)))
1490 W0 = (COS(G1*K1)-SIN(L2)*L9)/COS(L2)/COS(L0)
1500 IF W0 = 0 THEN W0 = .0000001
1510 W0 = ATN(SQR(1-W0*W0)/W0)+P1/2*(1-SGN(W0))
1520 W0 = P1-SGN(P1-G1*K1)*(P1-W0)
1530 W0 = W3+W0*SGN (W3-P1)*SGN(P1-G1)+W1-.001
1540 W0 = W0-P1*(1-SGN(P1+P1-W0))
1550 ' LOCAL NOON.
1560 T0 = 3.82*W0+12+Y1
1570 T0 = T0-12*(1+SGN(T0-24))*SGN(ABS(T0-24))
1580 IF COS(L0+Y2)>-.26 THEN 1620
1590 T1(N) = 0
1600 GOTO 1740
1610 ' DURATION OF SUNLIGHT.
1620 T1(N) = (-.26+SIN(Y2)*L9)/(COS(Y2)*COS(L0)+.001)
1630 T1(N) = 12-ATN(T1(N)/SQR(ABS(1-T1(N)*T1(N))))*24/P1
1640 ' T(dawn)
1650 T7 = T0-T1(N)/2
1660 T3(N) = T7+12*(1-SGN(T7))*SGN(ABS(T7))
1670 ' T(sunset)
1680 T7 = T0+T1(N)/2
1690 T4(N) = T7-12*(1+ SGN(T7-24))*SGN(ABS(T7-24))
1700 C0(N) = ABS(COS(L0+Y2))
1710 ' RELAXATION TIME.
1720 T9(N) = 9.7*(C0(N)^8)
1730 IF T9(N)<.1 THEN T9(N) = .1
1740 K1 = 1-K1
1750 ' F0F 2 MULTIPLIER.
1760 M(N) = M9*.75*((12/T1(N)-1)*SGN(INT(12/T1(N)))+1)
1770 M(N) = M(N)*(1+S0/100*(1-(T1(N)/12-1)*SGN(INT(T1(N)/12))))
1780 L9 = ABS(L0+.21*SIN(W0+.35))
1790 G2 = .5
1800 IF L9<P1/4 THEN 1830
1810 M(N) = M(N)*(1-.1*(1+COS(L9*4)))
1820 G2 = .2
1830 L(N) = SIN(L9*4)*G2
1840 ' EFECTIVE COS(X) PRESETS.
1850 G8(N) = P1*T9(N)/T1(N)
1860 T7 = T1(N)/T9(N)
1870 IF T7>85 THEN T7 = 85
1880 G7(N) = C0(N)*G8(N)*(EXP(-T7)+1)
1890 G6(N) = G7(N)*EXP ((T1(N)-24)/2)
1900 NEXT N
1910 FOR T5 = 0 TO 23
1920 J9 = 100
1930 K9 = 0
1940 FOR N = 0 TO 1
1950 G0 = 0
1960 G3 = P1/2
1970 IF T1(N) = 0 THEN 2160
1980 IF T4(N)<T3(N) THEN 2030
1990 ' DAY TIME?
2000 IF (T5-T3(N))*(T4(N)-T5)>0 THEN 2050
2010 GOTO 2210
2020 ' NIGHT TIME?
2030 IF (T5-T4(N))*(T3(N)-T5)>0 THEN 2210
2040 ' EFECTIVE COS(X)(day)
2050 T6 = T5+12*(1+SGN(T3(N)-T5))*SGN(ABS(T3(N)-T5))
2060 G4 = P1*(T6-T3(N))/T1(N)
2070 T8 = (T3(N)-T6)/T9(N)
2080 IF ABS(T8)>85 THEN T8 = 85*SGN(T8)
2090 G0 = C0(N)*(SIN(G4)+G8(N)*(EXP(T8)-COS(G4)))
2100 G3 = P1/2
2110 IF T6-T3(N)>T1(N)/2+3 THEN 2130
2120 G3 = (T6-T3(N))/(T1(N)/2+3)*G3
2130 G3 = G3*(1+SGN(L(N)))
2140 IF G0<G6(N) THEN G0 = G6(N)
2150 ' F0F 2
2160 G2 = SQR(7+45*SQR(G0/(1+G8(N)*G8(N))))
2170 ' HPF
2180 G2 = G2*M(N)*1.27*(1+SIN(G3)*L(N))
2190 GOTO 2270
2200 ' EFECTIVE COS(X)(night)
2210 T6 = T5+12*(1+SGN(T4(N)-T5))*SGN(ABS(T4(N)-T5))
2220 G4 = P1*(T6-T4(N))/(24-T1(N))
2230 G0 = G7(N)*EXP((T4(N)-T6)/2)
2240 G3 = G4+(P1-G4)/4*(1+SGN(L(N)))
2250 G4 = 0
2260 GOTO 2160
2270 IF G2<J9 THEN J9 = G2
2280 ' E LAYER.
2290 Y8 = .2: IF T1(N) = 0 THEN 2360
2300 IF T1(N)*G4 = 0 THEN 2360
2310 Y9 = C0(N)*SIN(P1*(T6-T3(N))/T1(N))
2320 IF Y9 > .174 THEN 2350
2330 Y8 = (ATN(SQR(1-Y9*Y9)/Y9)*180/P1-76)^(-.4)
2340 GOTO 2360
2350 Y8 = Y9 ^ (.3)
2360 Y9 = (3.4+.00544*S0)*Y8*Y6
2370 IF Y9>7 THEN 2400
2380 Y9 = .9099999*Y9-.37
2390 GOTO 2410
2400 Y9 = (1.33*Y9-3.31)^(2)/7
2410 IF K9<Y9 THEN K9 = Y9
2420 NEXT N
2430 F1=(J9+.5):F2=((J9/1.27)*.8499999)+5 :F3=K9+.5
2440 IF M1 = 1 THEN GOSUB 2540 ELSE GOSUB 2480 ' PRINT LINE OF DATA
2450 NEXT T5 :IF M1=1 THEN 2470
2460 PRINT :IF P%=2 THEN LPRINT
2470 RETURN
2480 IF F1<F2 THEN PRINT "-- "; :GOTO 2500
2490 IF F3<F2 THEN PRINT USING "## ";F2; ELSE PRINT "++ ";
2500 IF P%=2 THEN 2510 ELSE 2530
2510 IF F1<F2 THEN LPRINT "-- "; :GOTO 2530
2520 IF F3<F2 THEN LPRINT USING "## ";F2; ELSE LPRINT "++ ";
2530 RETURN
2540 PRINT USING" ##";T5;:IF F1< F2 THEN PRINT " ------------ ";:GOTO 2570
2550 IF F2< F3 THEN PRINT " ++++++++++++ ";:GOTO 2570
2560 PRINT USING"###### ";INT(F1);INT(F2);INT(F3);:PRINT " ";
2570 IF P%=2 THEN 2580 ELSE 2610
2580 LPRINT USING" ##";T5;:IF F1< F2 THEN LPRINT " ------------ ";:GOTO 2610
2590 IF F2< F3 THEN LPRINT " ++++++++++++ ";:GOTO 2610
2600 IF P%=2 THEN LPRINT USING"###### ";INT(F1);INT(F2);INT(F3);:LPRINT " ";
2610 IF T5/2<>INT(T5/2) THEN PRINT :IF P%=2 THEN LPRINT
2620 RETURN
2630 PRINT P$;" PATH OPTIMAL FREQUENCY PREDICTIONS FOR ";G3ZCZ$;" ON ";D0;M0$:PRINT
2640 IF P%=2 THEN LPRINT C2$:LPRINT:LPRINT P$;" PATH OPTIMAL FREQUENCY PREDICTIONS FOR ";G3ZCZ$;" ON ";D0;M0$
2650 PRINT "SUNSPOT NUMBER ";S0:PRINT:IF P%=2 THEN LPRINT "SUNSPOT NUMBER ";S0:LPRINT
2660 PRINT "PX 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
2670 IF P%=2 THEN LPRINT " PX BEARING DISTANCE 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
2680 PRINT "------------------------------------------------------------------------------"
2690 IF P%=2 THEN LPRINT "------------------------------------------------------------------------------------------"
2700 RETURN
2710 LOCATE 17,1:PRINT "Which Mode, Single Px or Contest Sheet (S/C) ? "
2720 K$ = INKEY$:IF K$ = "" THEN 2720
2730 M1= INSTR("SC",K$):IF M1=0 THEN BEEP: GOTO 2720
2740 RETURN